home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / mothello.arc / MOTHELLO.PAS
Pascal/Delphi Source File  |  1987-01-26  |  13KB  |  438 lines
  1. {  Name:  OTHELLO.PAS                                                  }
  2. {  Programmer:  Calvin A. Jones                                        }
  3. {  Date written:   11/24/84                                            }
  4. {  Description:  Original PET version modified FOR Turbo Pascal        }
  5. {                under MS-DOS.                                         }
  6. {  Updated:      July 24, 1985    Phil Glatz                           }
  7. {                  MicroSoft mouse support added, Turbo 3.0 upgrade    }
  8.  
  9. PROGRAM Othello;
  10.  
  11. {$V-}
  12.  
  13. CONST
  14.   fff = green;
  15.   bbb = black;
  16.  
  17.   c: ARRAY[1..2] OF INTEGER = (blue,red);
  18.   i4: ARRAY[0..7] OF INTEGER = (-1, 0, 1,1,1,0,-1,-1);
  19.   j4: ARRAY[0..7] OF INTEGER = (-1,-1,-1,0,1,1, 1, 0);
  20.  
  21. TYPE
  22.   charset = set OF CHAR;
  23.   ArgString = STRING[255] ;
  24.  
  25. VAR
  26.   ch: CHAR;
  27.   sc: ARRAY[1..2] OF INTEGER;
  28.   a: ARRAY[0..9,0..9] OF INTEGER;
  29.   player: ARRAY[1..2] OF string[15];
  30.   n1,np,op,pt,s1,s2,s3,s4,s5: INTEGER;
  31.   Passing : BOOLEAN ;
  32.   MouseX, MouseY,
  33.   xl,xh,yl,yh: INTEGER;
  34.   done,over: BOOLEAN;
  35.  
  36. {$I c:\turbo\inc\mouse.inc }
  37.  
  38. procedure getchar(VAR ch: CHAR; range: charset);
  39.   BEGIN
  40.     REPEAT
  41.       read(kbd,ch);
  42.       IF ch=#27 THEN Begin TextMode ; halt end ;
  43.       ch:=upcase(ch);
  44.     UNTIL ch in range;
  45.   END;
  46.  
  47. procedure score;
  48.   VAR
  49.     i,j: INTEGER;
  50.   BEGIN
  51.     window(1,1,40,20);
  52.     textbackground(cyan);
  53.     FOR i:=1 to 8 do
  54.       FOR j:=1 to 8 do
  55.         IF a[i,j]<>0 THEN
  56.         BEGIN
  57.           textcolor(c[a[i,j]]);
  58.           GotoXY(4*i+1,2*j+3); WRITE(chr(a[i,j]));
  59.         END;
  60.     textcolor(c[1]);
  61.     GotoXY(38,5); WRITE(sc[1]:2);
  62.     textcolor(c[2]);
  63.     GotoXY(38,19); WRITE(sc[2]:2);
  64.     textcolor(fff); textbackground(bbb);
  65.     IF (sc[op]=0) or (n1=64) THEN
  66.     BEGIN
  67.       window(1,21,40,24);
  68.       clrscr;
  69.       WriteLn(player[1],' has ',sc[1],' pieces');
  70.       WriteLn(player[2],' has ',sc[2],' pieces');
  71.       IF sc[1]=sc[2] THEN WriteLn('It is a tie !!')
  72.       ELSE
  73.       BEGIN
  74.         IF sc[1]>sc[2] THEN WRITE(player[1]) ELSE WRITE(player[2]);
  75.         WriteLn(' won !!!');
  76.       END;
  77.       over:=TRUE;
  78.       WRITE('Do you want to play again? ');
  79.       getchar(ch,['Y','N']);
  80.       IF (ch)='N' THEN done:=TRUE;
  81.     END;
  82.   END;
  83.  
  84. procedure intro;
  85.   VAR
  86.     i : INTEGER ;
  87.  
  88.   BEGIN
  89.     textmode(c40);
  90.     textcolor(black); textbackground(black);
  91.     ClrScr ;
  92.     textcolor(white); textbackground(cyan);
  93.     GotoXY(19,5); WRITE('IBM');
  94.     GotoXY(12,7); WRITE('Personal Computer');
  95.     GotoXY(8,10); WRITE('╒═══════════════════════╕');
  96.     GotoXY(8,11); WRITE('│  -*-   OTHELLO   -*-  │');
  97.     GotoXY(8,12); WRITE('│                       │');
  98.     GotoXY(8,13); WRITE('│     Author: Unkown    │');
  99.     GotoXY(8,14); WRITE('│ Adapted by: P. Leabo  │');
  100.     GotoXY(8,15); WRITE('│Enhanced by: R. Vollmer│');
  101.     GotoXY(8,16); WRITE('│Pacsal Ver.: C. Jones  │');
  102.     GotoXY(8,16); WRITE('│ Mouse Ver.: P. Glatz  │');
  103.     GotoXY(8,17); WRITE('╘═══════════════════════╛');
  104.     GotoXY(5,20); WRITE('Orig. written FOR: PET computer');
  105.     GotoXY(10,21); WRITE('Last update: 07/24/85');
  106.     i := 0 ;
  107.     WHILE (NOT KeyPressed) AND (i < 50) DO     (* delay until key pressed or 5 sec *)
  108.       BEGIN
  109.         Delay(100) ;
  110.         i := Succ(i)
  111.       END
  112.   END;
  113.  
  114. procedure instructions;
  115.   BEGIN
  116.     textmode(c80);
  117.     textcolor(7); textbackground(1);
  118.     clrscr;
  119.     window(10,1,70,24);
  120.     GotoXY(20,4); WriteLn('GREETINGS FROM OTHELLO');
  121.     WriteLn;
  122.     WriteLn('Othello is played on an 8 x 8 board, rows numbered 1 to 8');
  123.     WriteLn('and columns numbered A to H.  The initial configuration is');
  124.     WriteLn('all blank except FOR the four center squares.  Try to place');
  125.     WriteLn('your pieces so that it outflanks your opponent, creating');
  126.     WriteLn('horizontal, vertical, or diagonal runs of opposing pieces,');
  127.     WriteLn('turning them into yours.');
  128.     WriteLn;
  129.     WriteLn('Make your move by pointing to the square you wish and press');
  130.     WriteLn('mouse button # 1.');
  131.     WriteLn;
  132.     WriteLn('Note:  You must capture at least one OF your opponent''s');
  133.     WriteLn('pieces.  If it is not possible, you forfeit your move by');
  134.     WriteLn('pointing at Pass.');
  135.     WriteLn('Point at Quit to abort the game');
  136.     WriteLn('You may also specify whether you are player 1 or 2 by typing');
  137.     WriteLn('MOTHELLO n, (where n is 1 or 2) on the command line.  This');
  138.     WriteLn('will also skip this instruction screen.') ;
  139.     WriteLn; WriteLn;
  140.     WRITE('Press any key to continue...'); read(kbd,ch);
  141.   END;
  142.  
  143. procedure initialize;
  144.   VAR
  145.     i,j: INTEGER;
  146.     Arg : String[1] ;
  147.  
  148.   PROCEDURE GetAnswers ;
  149.     BEGIN
  150.           WRITE('How many players? (1 or 2) ');
  151.           getchar(ch,['1','2']); WriteLn(ch);
  152.           np:=ord(ch)-ord('0');
  153.           WriteLn;
  154.           WRITE('Player 1''s name: '); readln(player[1]);
  155.           IF np=2 THEN
  156.           BEGIN
  157.             WRITE('Player 2''s name: '); readln(player[2]);
  158.           END;
  159.           IF np<>2 THEN
  160.           BEGIN
  161.             player[2]:='Computer';
  162.             WriteLn; WRITE('Should I play my best? ');
  163.             getchar(ch,['Y','N']);
  164.             IF ch='Y' THEN
  165.             BEGIN
  166.               WriteLn('YES');
  167.               s2:=2; s4:=1; s5:=-2;
  168.             END
  169.           ELSE
  170.             BEGIN
  171.               WriteLn('NO');
  172.               s2:=0; s4:=0; s5:=0;
  173.             END;
  174.           END;
  175.     END ; (* Procedure GetAnswers *)
  176.  
  177.  
  178.   BEGIN
  179.     window(1,1,80,24);
  180.     textmode(c40);
  181.     done:=FALSE; over:=FALSE;
  182.     xl:=3; xh:=6;
  183.     yl:=3; yh:=6;
  184.     IF ParamCount = 0 THEN
  185.       GetAnswers
  186.     ELSE
  187.       BEGIN
  188.         np := 1 ;
  189.         player[1] := '' ;
  190.         player[2] := '' ;
  191.         Arg := (ParamStr(1)) ;
  192.         IF (Arg[1] IN ['1'..'2']) THEN np:=ord(Arg[1])-ord('0')
  193.         ELSE np := 1 ;
  194.         s2:=0; s4:=0; s5:=0
  195.       END ;
  196.     FOR i:=0 to 9 do
  197.       FOR j:=0 to 9 do a[i,j]:=0;
  198.     a[4,4]:=1; a[4,5]:=2;
  199.     a[5,4]:=2; a[5,5]:=1;
  200.     n1:=4;
  201.     op:=1;
  202.     FOR i:=1 to 2 do sc[i]:=2;
  203.   END;
  204.  
  205. procedure draw_board;
  206.   BEGIN
  207.     clrscr;
  208.     textcolor(magenta); textbackground(blue);
  209.     GotoXY(5,1); WriteLn('O T H E L L O');
  210.     textcolor(LightGray);
  211.     GotoXY(30,1); WriteLn('Pass   Quit');
  212.     GotoXY(1,3);
  213.     textcolor(brown); textbackground(lightgray);
  214.     WriteLn('    1   2   3   4   5   6   7   8  ');
  215.     WriteLn('  ╔═══╦═══╦═══╦═══╦═══╦═══╦═══╦═══╗');
  216.     WriteLn('A ║   ║   ║   ║   ║   ║   ║   ║   ║');
  217.     WriteLn('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  218.     WriteLn('B ║   ║   ║   ║   ║   ║   ║   ║   ║');
  219.     WriteLn('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  220.     WriteLn('C ║   ║   ║   ║   ║   ║   ║   ║   ║');
  221.     WriteLn('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  222.     WriteLn('D ║   ║   ║   ║   ║   ║   ║   ║   ║');
  223.     WriteLn('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  224.     WriteLn('E ║   ║   ║   ║   ║   ║   ║   ║   ║');
  225.     WriteLn('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  226.     WriteLn('F ║   ║   ║   ║   ║   ║   ║   ║   ║');
  227.     WriteLn('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  228.     WriteLn('G ║   ║   ║   ║   ║   ║   ║   ║   ║');
  229.     WriteLn('  ╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣');
  230.     WriteLn('H ║   ║   ║   ║   ║   ║   ║   ║   ║');
  231.     WriteLn('  ╚═══╩═══╩═══╩═══╩═══╩═══╩═══╩═══╝');
  232.     textcolor(blue);
  233.     GotoXY(36,5); WRITE(chr(1));
  234.     textcolor(red);
  235.     GotoXY(36,19); WRITE(chr(2));
  236.     score;
  237.   END;
  238.  
  239. function test_move(x,y: INTEGER): BOOLEAN;
  240.   VAR i,j: INTEGER;
  241.   BEGIN
  242.     test_move:=FALSE;
  243.     FOR i:=-1 to 1 do
  244.       FOR j:=-1 to 1 do
  245.         IF a[x+i,y+j]=op THEN test_move:=TRUE;
  246.   END;
  247.  
  248. procedure count_flank(x,y,z: INTEGER);
  249.   VAR i5,j5,i6,j6,k,k1: INTEGER;
  250.   BEGIN
  251.     s1:=0; k:=0;
  252.     while k<8 do
  253.     BEGIN
  254.       s3:=0;
  255.       i5:=i4[k]; j5:=j4[k]; i6:=x+i5; j6:=y+j5;
  256.       IF a[i6,j6]=op THEN
  257.       BEGIN
  258.         REPEAT
  259.           s3:=s3+1;
  260.           i6:=i6+i5; j6:=j6+j5;
  261.         UNTIL (a[i6,j6]=0) or (a[i6,j6]=pt);
  262.         IF a[i6,j6]=pt THEN
  263.         BEGIN
  264.           s1:=s1+s3;
  265.           IF z=1 THEN
  266.           BEGIN
  267.             i6:=x; j6:=y;
  268.             FOR k1:=0 to s3 do
  269.             BEGIN
  270.               a[i6,j6]:=pt;
  271.               i6:=i6+i5; j6:=j6+j5;
  272.             END;
  273.           END;
  274.         END;
  275.       END;
  276.       k:=k+1;
  277.     END;
  278.   END;
  279.  
  280. procedure show_move(x,y: INTEGER);
  281.   BEGIN
  282.     window(1,1,40,20);
  283.     GotoXY(4*x+1,2*y+3);
  284.     textcolor(c[pt]+blink); textbackground(lightgray);
  285.     WRITE(chr(pt));
  286.     textcolor(fff); textbackground(bbb);
  287.     delay(2500);
  288.     window(1,21,40,24);
  289.     GotoXY(1,1);
  290.     count_flank(x,y,1);
  291.     sc[pt]:=sc[pt]+s1+1;
  292.     sc[op]:=sc[op]-s1;
  293.     n1:=n1+1;
  294.   END;
  295.  
  296. procedure computer_move;
  297.   VAR i,j,b1,i3,j3: INTEGER;
  298.   BEGIN
  299.     window(1,21,40,25);
  300.     clrscr;
  301.     IF Passing THEN WriteLn('Passing...') ELSE WriteLn;
  302.     textcolor(fff+blink);
  303.     WriteLn('I am thinking!');
  304.     textcolor(fff);
  305.     b1:=-1; i3:=0; j3:=0;
  306.     FOR i:=xl to xh do
  307.       FOR j:=yl to yh do
  308.         IF a[i,j]=0 THEN
  309.           IF test_move(i,j) THEN
  310.           BEGIN
  311.             count_flank(i,j,0);
  312.             IF s1>0 THEN
  313.             BEGIN
  314.               IF (i=1) or (i=8) THEN s1:=s1+s2;
  315.               IF (j=1) or (j=8) THEN s1:=s1+s2;
  316.               IF (i=2) or (i=7) THEN s1:=s1+s5;
  317.               IF (j=2) or (j=7) THEN s1:=s1+s5;
  318.               IF (i=3) or (i=6) THEN s1:=s1+s4;
  319.               IF (j=3) or (j=6) THEN s1:=s1+s4;
  320.               IF s1>=b1 THEN
  321.                 IF (s1>b1) or (random(1)>0.5) THEN
  322.                 BEGIN
  323.                   b1:=s1; i3:=i; j3:=j;
  324.                 END;
  325.             END;
  326.           END;
  327.     IF (i3 in [1..8]) and (j3 in [1..8]) THEN
  328.     BEGIN
  329.       i:=i3; j:=j3;
  330.       show_move(i,j);
  331.       IF (i<=xl) and (i<>1) THEN xl:=xl-1;
  332.       IF (i>=xh) and (i<>8) THEN xh:=xh+1;
  333.       IF (j<=yl) and (j<>1) THEN yl:=yl-1;
  334.       IF (j>=yh) and (j<>8) THEN yh:=yh+1;
  335.     END
  336.     ELSE WriteLn('Computer passes.');
  337.     delay(2500);
  338.   END;
  339.  
  340.  
  341.  
  342. procedure player_move;
  343.   CONST
  344.     term: charset = ['1'..'8','A'..'H',^M];
  345.   VAR
  346.     d,i,j: INTEGER;
  347.     goodmove: BOOLEAN;
  348.   BEGIN
  349.     window(1,21,40,25);
  350.     clrscr;
  351.     WriteLn;
  352.     goodmove:=FALSE;
  353.     Passing := FALSE ;
  354.     over := FALSE ;
  355.     REPEAT
  356.       WRITE(player[pt],' ');
  357.       textcolor(c[pt]); WRITE(chr(pt));
  358.       textcolor(fff); WRITE(', enter your move: ');
  359.       i:=-1; j:=-1;
  360.       REPEAT
  361.         IF (MousePosition(MouseX, MouseY) = 1) THEN
  362.           IF (MouseY = 0) THEN
  363.             CASE MouseX OF
  364.               464..512 : Passing := TRUE ;
  365.               576..624 : BEGIN
  366.                            goodmove := TRUE ;
  367.                            done := TRUE ;
  368.                            over := TRUE
  369.                          END
  370.             ELSE END    (* CASE *)
  371.           ELSE
  372.             BEGIN
  373.               i := ((MouseX-64) DIV 64) + 1 ;
  374.               j := ((MouseY-32) DIV 16) + 1 ;
  375.               Sound(500) ;
  376.               Delay(2) ;
  377.               Sound(300) ;
  378.               Delay(3) ;
  379.               NoSound ;
  380.               Delay(250)     (* pause to eliminate bounce *)
  381.             END   (* IF *)
  382.       UNTIL ((i>0) and (j>0)) OR Passing OR over ;
  383.       IF Passing THEN
  384.         BEGIN
  385.           FOR d := 300 TO 1950 DO Sound(d) ;
  386.           Delay(5) ;
  387.           NoSound ;
  388.           Delay(200) ;
  389.           goodmove:=TRUE
  390.         END
  391.       ELSE IF (NOT over) THEN
  392.       BEGIN
  393.         IF a[i,j]=0 THEN
  394.         BEGIN
  395.           IF test_move(i,j) THEN
  396.           BEGIN
  397.             count_flank(i,j,0);
  398.             IF s1>0 THEN
  399.             BEGIN
  400.               goodmove:=TRUE;
  401.               show_move(i,j);
  402.             END
  403.             ELSE WriteLn('Sorry, does not flank a row.')
  404.           END
  405.           ELSE WriteLn('Sorry, not next to opponents pieces.')
  406.         END
  407.         ELSE WriteLn('Sorry, square occupied; try again.');
  408.       END;            (* PlayerMove *)
  409.     UNTIL goodmove;
  410.   END;
  411.  
  412. BEGIN
  413.   intro;
  414.   IF ParamCount = 0 THEN instructions;
  415.   REPEAT
  416.     initialize;
  417.     InstallMouse ;
  418.     draw_board;
  419.     SetTextCursor(TRUE,1,5) ;
  420.     ShowMouse ;
  421.     REPEAT
  422.       pt:=1; op:=2;
  423.       player_move;
  424.       score;
  425.       IF not over THEN
  426.       BEGIN
  427.         pt:=2; op:=1;
  428.         IF np=2 THEN player_move ELSE computer_move;
  429.         score;
  430.       END;
  431.     UNTIL over;
  432.   UNTIL done;
  433.   NoSound ;
  434.   QuitMouse ;
  435.   window(1,1,80,24);
  436.   textmode(c80);
  437. END.
  438.